home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / cli / mx2src.arc / XMODEM.MOD < prev    next >
Encoding:
Modula Implementation  |  1989-01-05  |  19.5 KB  |  608 lines
  1.  
  2. (*              Copyright 1987 fred brooks LogicTek             *)
  3. (*                                                              *)
  4. (*                                                              *)
  5. (*   First Release                      12/8/87-FGB             *)
  6. (*   Minor fixups                       3/7/88-FGB              *)
  7. (*                                                              *)
  8.  
  9. (*$T-,$S-,$A+ *)
  10. (* This version of xmodem has been written using UNIX and the sealink
  11.    C programming versions as examples. Many thanks to those who have done
  12.    this before me.        Fred Brooks                                   *)
  13.  
  14. IMPLEMENTATION MODULE XMODEM;
  15. FROM SYSTEM     IMPORT ADDRESS, CODE, REGISTER, SETREG, ADR, WORD;
  16. FROM GEMX       IMPORT BasePageAddress, BasePageType ;
  17. FROM BIOS       IMPORT BConStat, BCosStat, BConIn, BConOut, Device;
  18. FROM XBIOS      IMPORT SuperExec;
  19. FROM GEMDOS     IMPORT Create, Open, Close, Write, Read, GetDTA, SFirst;
  20. FROM TextIO     IMPORT WriteString, WriteLn, WriteInt,  WriteAdr;
  21. FROM BitStuff   IMPORT WAnd, WEor, WShl, WShr;
  22. FROM Strings    IMPORT String, Assign;
  23.  
  24. TYPE            CharPtr       =          POINTER TO ARRAY [0..MAX(LONGINT)] OF CHAR;
  25.  
  26. CONST           SECSIZ        =          80H;
  27.                 BUFSIZ        =          200H;
  28.                 ERRORMAX      =          20;
  29.                 RETRYMAX      =          20;
  30.                 SOH           =          1c;
  31.                 EOT           =          4c;
  32.                 ACK           =          6c;
  33.                 NAK           =          25c;
  34.                 C             =          103c;
  35.                 RTS           =          4e75H;
  36.                 BELL          =          7c;
  37.                 CTRLZ         =          32c;
  38.  
  39. VAR             result,mtimeout         :       INTEGER;
  40.                 filename                :       String;
  41.                 hz200 [04baH]           :       LONGCARD;
  42.                 t1,prtime               :       LONGCARD;
  43.                 readchar                :       CHAR;
  44.                 filesize                :       POINTER TO LONGCARD;
  45.                 snd,rec,ok              :       BOOLEAN;
  46.  
  47. (*$P- *)
  48. PROCEDURE       rdtime();       (* read 200hz clock *)
  49. BEGIN
  50.         prtime:=hz200;
  51.         CODE(RTS);
  52. END             rdtime;
  53. (*$P+ *)
  54.  
  55. PROCEDURE       GetTime(): LONGCARD;
  56. BEGIN
  57.         SuperExec(rdtime);
  58.         RETURN prtime;
  59. END             GetTime;
  60.  
  61. PROCEDURE       timerset(time: INTEGER): LONGCARD;
  62. BEGIN
  63.         RETURN (LONGCARD(time)+(GetTime() DIV 20));
  64. END             timerset;
  65.  
  66. PROCEDURE       timeup(timer: LONGCARD): BOOLEAN;
  67. BEGIN
  68.         IF ((GetTime() DIV 20)>timer) OR ((GetTime() DIV 20)=timer) THEN
  69.            RETURN TRUE;
  70.         ELSE
  71.            RETURN FALSE;
  72.         END;
  73. END             timeup;
  74.  
  75. PROCEDURE       errorbells;
  76. VAR             i,delay        :       CARDINAL;
  77. BEGIN
  78.            FOR i:=0 TO 3 DO
  79.                FOR delay:=0 TO 10000 DO END;
  80.                BConOut(CON,BELL);
  81.            END;
  82. END             errorbells;
  83.  
  84. PROCEDURE       crcupdate(crcvalue: CARDINAL; data: CHAR): CARDINAL;
  85. CONST           GEN1X5X12X16                  =     1021H;
  86. VAR             i,xin,cha                     :     INTEGER;
  87.                 t                             :     CARDINAL;
  88. BEGIN
  89.         cha:=INTEGER(data);
  90.         FOR i:=0 TO 7 DO
  91.             xin:=INTEGER(WAnd(crcvalue,8000H));
  92.             cha:=INTEGER(WShl(cha,1));
  93.             IF INTEGER(WAnd(cha,100H))#0 THEN
  94.                t:=crcvalue;
  95.                crcvalue:=1+CARDINAL(WShl(t,1));
  96.             ELSE
  97.                t:=crcvalue;
  98.                crcvalue:=0+CARDINAL(WShl(t,1));
  99.             END;
  100.             IF xin#0 THEN 
  101.                crcvalue:=CARDINAL(WEor(crcvalue,GEN1X5X12X16));
  102.             END;
  103.         END;
  104.         RETURN crcvalue;
  105. END             crcupdate;
  106.  
  107. PROCEDURE       crcfinish(crcvalue: CARDINAL): CARDINAL;
  108. BEGIN
  109.         RETURN CARDINAL(WAnd(crcupdate(crcupdate(crcvalue,0c),0c),0ffffH));
  110.  
  111.  
  112. END             crcfinish;
  113.  
  114. PROCEDURE       IAnd255(num: INTEGER): INTEGER;
  115. BEGIN
  116.         RETURN INTEGER(WAnd(num,0ffH));
  117. END             IAnd255;
  118.  
  119. PROCEDURE       mdmini;
  120. BEGIN
  121.         ok:=FALSE;
  122.         xmodemerror:=0;
  123.         xmodemabort:=FALSE;
  124.         mtimeout:=120;
  125.         mdmBytesXferred:=0;
  126.         mdmPacketsSent:=0;
  127.         mdmPacketsReceived:=0;
  128.         mdmBadPackets:=0;
  129.         mdmNakedPackets:=0;
  130. END             mdmini;
  131.  
  132. PROCEDURE       xmodemstat;
  133. BEGIN
  134.         WriteLn;
  135.         WriteString("      XMODEM STATUS       ");
  136.         IF rec THEN 
  137.            WriteString(" receiver active       ");
  138.            WriteString(xfrname);
  139.            IF crcmode THEN
  140.               WriteString(" CRC mode.");
  141.            ELSE
  142.               WriteString(" CHECKSUM mode.");
  143.            END;
  144.         END;
  145.         IF snd THEN 
  146.            WriteString(" transmitter active    "); 
  147.            WriteString(xfrname);
  148.            IF crcmode THEN
  149.               WriteString(" CRC mode.");
  150.            ELSE
  151.               WriteString(" CHECKSUM mode.");
  152.            END;
  153.         END;
  154.         WriteLn;
  155.         IF ok THEN
  156.            WriteString("       Transfer complete.  ");
  157.            WriteLn;
  158.         END;
  159.         IF xmodemerror#0 THEN
  160.            WriteString("       Transfer aborted!  ");
  161.            errorbells;
  162.            WriteLn;
  163.         END;
  164.         WriteLn;
  165.         WriteString(" Total packets sent  ");
  166.         WriteInt(mdmPacketsSent,12);
  167.         WriteLn;
  168.         WriteString(" Packets left        ");
  169.         WriteInt(endblk,12);
  170.         WriteLn;
  171.         WriteString(" Packets received    ");
  172.         WriteInt(mdmPacketsReceived,12);
  173.         WriteLn;
  174.         WriteString(" Bad packets         ");
  175.         WriteInt(mdmBadPackets,12);
  176.         WriteLn;
  177.         WriteString(" Naked packets sent  ");
  178.         WriteInt(mdmNakedPackets,12);
  179.         WriteLn;
  180.         WriteString(" Bytes transferred   ");
  181.         WriteAdr(ADDRESS(mdmBytesXferred),12);
  182.         WriteLn;
  183. END             xmodemstat;
  184.  
  185. PROCEDURE       setbuffer(char: CharPtr; length: CARDINAL; value: CHAR);
  186. VAR             data            :        POINTER TO CHAR;
  187. BEGIN
  188.         WHILE length#0 DO
  189.               data:=ADDRESS(char);
  190.               data^:=value;
  191.               INC(char);
  192.               DEC(length);
  193.         END;
  194. END             setbuffer;
  195.  
  196. PROCEDURE       writeModem(char: CharPtr; count: LONGCARD);
  197. VAR             data             :        POINTER TO CHAR;
  198. BEGIN
  199.         WHILE count#0 DO
  200.               DEC(count);
  201.               data:=ADDRESS(char);
  202.               INC(char);
  203.  
  204.               sendchar(data^);
  205.         END;
  206. END             writeModem;
  207.  
  208. PROCEDURE       readModem(VAR char: CHAR; time: INTEGER);
  209. VAR             data         :  CHAR;
  210.                 longchar     :  LONGCARD;
  211.                 t            :  BITSET;
  212.                 WaitTime     :  LONGCARD;
  213.                 ticks        :  CARDINAL;
  214. BEGIN
  215.         IF time=0 THEN
  216.            IF BConStat(AUX) THEN (* return char *)
  217.               longchar:=BConIn(AUX);
  218.               t:=BITSET(longchar);
  219.               EXCL(t,8);
  220.               char:=CHAR(t);
  221.               RETURN; 
  222.            ELSE
  223.               char:=CHAR(255);
  224.               RETURN;
  225.            END;
  226.         END;
  227.  
  228.         WaitTime:=LONGCARD(time)+(GetTime() DIV 20);
  229.         ticks:=0;
  230.         LOOP
  231.                 IF BConStat(AUX) THEN
  232.                    longchar:=BConIn(AUX);
  233.                    t:=BITSET(longchar);
  234.                    EXCL(t,8);
  235.                    char:=CHAR(t);
  236.                    RETURN;
  237.                 END;
  238.         IF ((GetTime() DIV 20)>WaitTime) 
  239.         OR ((GetTime() DIV 20)=WaitTime) THEN
  240.            INC(ticks);
  241.            WaitTime:=LONGCARD(time)+(GetTime() DIV 20);
  242.            IF ticks=2 THEN
  243.               char:=CHAR(255);
  244.               RETURN;
  245.            END;
  246.         END;
  247.         END; (* loop *)
  248. END             readModem;
  249.  
  250. PROCEDURE       flushinput();
  251. VAR             char    :       LONGCARD;
  252. BEGIN
  253.         WHILE BConStat(AUX) DO
  254.               char:=BConIn(AUX);
  255.         END;
  256. END             flushinput;
  257.  
  258. PROCEDURE       sendchar(char: CHAR);
  259. BEGIN
  260.         BConOut(AUX,char);
  261. END             sendchar;
  262.  
  263. PROCEDURE       xmodemrec(filename: ARRAY OF CHAR): BOOLEAN;
  264. VAR             sectnum,sectcurr,sectcomp,fd            :       INTEGER;
  265.                 errors                                  :       INTEGER;
  266.                 firstchar                               :       CHAR;
  267.                 errorflag,goodcheck,crc1,crc2           :       BOOLEAN;
  268.                 checksum,j,bufptr                       :       CARDINAL;
  269.                 b                                       :       LONGCARD;
  270.                 bufr                                    :       ARRAY [0..BUFSIZ] OF CHAR;
  271. BEGIN
  272.         IF rec OR snd THEN
  273.            WriteLn;
  274.            WriteString(" XMODEM already active! ");
  275.            WriteLn;
  276.            RETURN FALSE;
  277.         END;
  278.         rec:=TRUE;
  279.         mdmini();
  280.         SFirst(filename,0,result);
  281.         IF result=0 THEN
  282.            WriteLn;
  283.            WriteString(filename);
  284.            WriteString(" already exists! ");
  285.            WriteLn;
  286.            errorbells;
  287.            xmodemerror:=(-1);
  288.            rec:=FALSE;
  289.            RETURN FALSE;
  290.         END;
  291.         Create(filename,0,fd);
  292.         IF fd<0 THEN
  293.            WriteLn;
  294.            WriteString("GEMDOS ERROR # ");
  295.            WriteInt(fd,2);
  296.            WriteLn;
  297.            xmodemerror:=fd;
  298.            IF Close(fd) THEN END;
  299.            rec:=FALSE;
  300.            RETURN FALSE;
  301.       ELSE
  302.            Assign(xfrname,filename);
  303.            WriteString(" receiving ");
  304.            WriteString(filename);
  305.            WriteLn;
  306.         END;
  307. (*        crcmode:=TRUE; *)
  308.         sectnum:=0; errors:=0; bufptr:=0;
  309.         flushinput();
  310.         IF crcmode THEN
  311.            sendchar(C);
  312.         ELSE
  313.            sendchar(NAK);
  314.         END;
  315.  
  316.         WHILE (firstchar#EOT) AND (errors#ERRORMAX) DO
  317.               errorflag:=FALSE;
  318.  
  319.               t1:=timerset(50);
  320.               REPEAT
  321.                 readModem(readchar,5);
  322.                 firstchar:=readchar;
  323.                 IF xmodemabort THEN
  324.                    IF Close(fd) THEN END;
  325.                    xmodemerror:=(-11);
  326.                    rec:=FALSE;
  327.                    RETURN FALSE;
  328.                 END;
  329.                 IF timeup(t1) THEN
  330.                    t1:=timerset(50);
  331.                    flushinput();
  332.                    IF crcmode THEN
  333.                       sendchar(C);
  334.                    ELSE
  335.                       sendchar(NAK);
  336.                    END;
  337.                    IF errors>ERRORMAX DIV 2 THEN crcmode:=NOT crcmode END;
  338.                    INC(errors);
  339.                    IF errors>ERRORMAX THEN 
  340.                       IF Close(fd) THEN END;
  341.                       xmodemerror:=(-1);
  342.                       rec:=FALSE;
  343.                       RETURN FALSE;
  344.                    END;
  345.                 END;
  346.               UNTIL (firstchar=SOH) OR (firstchar=EOT);
  347.  
  348.               IF firstchar=SOH THEN
  349.                  readModem(readchar,5);
  350.                  sectcurr:=INTEGER(readchar);
  351.                  readModem(readchar,5);
  352.                  sectcomp:=INTEGER(readchar);
  353.                  IF sectcurr+sectcomp=255 THEN
  354.                     IF sectcurr=IAnd255(sectnum+1) THEN
  355.                        checksum:=0;
  356.                        FOR j:=bufptr TO bufptr+SECSIZ-1 DO
  357.                            IF xmodemabort THEN
  358.                               IF Close(fd) THEN END;
  359.                               xmodemerror:=(-11);
  360.                               rec:=FALSE;
  361.                               RETURN FALSE;
  362.                            END;
  363.                            readModem(readchar,5);
  364.                            bufr[j]:=readchar;
  365.                            IF crcmode THEN
  366.                               checksum:=crcupdate(checksum,bufr[j]);
  367.                            ELSE
  368.                               checksum:=checksum+CARDINAL(bufr[j]);
  369.                            END;
  370.                        END; (* for *)
  371.  
  372.                   IF crcmode THEN
  373.                      crc1:=FALSE; crc2:=FALSE;
  374.                      (*
  375.                      FOR j:=bufptr TO bufptr+SECSIZ-1 DO
  376.                          checksum:=crcupdate(checksum,bufr[j]);
  377.                      END;
  378.                      *)
  379.                      checksum:=crcfinish(checksum);
  380.                      readModem(readchar,5);
  381.                      IF readchar=CHAR(IAnd255(CARDINAL(WShr(checksum,8)))) THEN
  382.                         crc1:=TRUE;
  383.                      END;
  384.                      readModem(readchar,5);
  385.                      IF readchar=CHAR(IAnd255(checksum)) THEN
  386.                         crc2:=TRUE;
  387.                      END;
  388.                      IF crc1 AND crc1 THEN
  389.                         goodcheck:=TRUE;
  390.                      ELSE
  391.                         goodcheck:=FALSE;
  392.                      END;
  393.                   ELSE
  394.                   (*
  395.                      FOR j:=bufptr TO bufptr+SECSIZ-1 DO
  396.                          checksum:=checksum+CARDINAL(bufr[j]);
  397.                      END;
  398.                   *)
  399.                      readModem(readchar,5);
  400.                      IF checksum=CARDINAL(readchar) THEN
  401.                         goodcheck:=TRUE;
  402.                      ELSE
  403.                         goodcheck:=FALSE;
  404.                      END;
  405.                   END;
  406.  
  407.  
  408.                        IF goodcheck THEN
  409.                           INC(mdmPacketsReceived);
  410.                           errors:=0;
  411.                           INC(sectnum);
  412.                           bufptr:=bufptr+SECSIZ;
  413.                           mdmBytesXferred:=mdmBytesXferred+SECSIZ;
  414.                           IF bufptr=BUFSIZ THEN
  415.                              bufptr:=0;
  416.                              b:=BUFSIZ;
  417.                              Write(fd,b,ADR(bufr));
  418.                           END;
  419. (*     this is for error checking for the write *)
  420.                           flushinput;
  421.                           sendchar(ACK);
  422.                        ELSE
  423.                           INC(mdmBadPackets);
  424.                           errorflag:=TRUE;
  425.                        END; (* if *)
  426.                     ELSE
  427.                        IF sectnum=IAnd255(sectnum) THEN
  428.                           flushinput;
  429.                           sendchar(ACK);
  430.                        ELSE
  431.                           INC(mdmBadPackets);
  432.                           errorflag:=TRUE;
  433.                        END;
  434.                     END; (* if *)
  435.                  ELSE
  436.                     INC(mdmBadPackets);
  437.                     errorflag:=TRUE;
  438.                  END; (* if *)
  439.               IF errorflag THEN
  440.                  INC(errors);
  441.                  flushinput;
  442.                  IF crcmode THEN
  443.                     sendchar(C);
  444.                  ELSE
  445.                     sendchar(NAK);
  446.                  END;
  447.               END;
  448.               END; (* if *)
  449.         END; (* while *)
  450.         IF (firstchar=EOT) AND (errors< ERRORMAX) THEN
  451.            sendchar(ACK);
  452.            b:=LONGCARD(bufptr);
  453.            Write(fd,b,ADR(bufr));
  454.            IF Close(fd) THEN END;
  455.            xmodemerror:=0;
  456.            rec:=FALSE;
  457.            ok:=TRUE;
  458.            RETURN TRUE;
  459.         END;
  460.         IF Close(fd) THEN END;
  461.         xmodemerror:=(-1);
  462.         rec:=FALSE;
  463.         RETURN FALSE;
  464. END             xmodemrec;
  465.  
  466. PROCEDURE       xmodemsnd(filename: ARRAY OF CHAR): BOOLEAN;
  467. VAR             sectnum,attempts,fd          :   INTEGER;
  468.                 checksum,j,bufptr            :   CARDINAL;
  469.                 readchar,c,nak               :   CHAR;
  470.                 b                            :   LONGCARD;
  471.                 dtaAdr                       :   ADDRESS;
  472.                 bufr                         :   ARRAY [0..BUFSIZ] OF CHAR;
  473. BEGIN
  474.         IF rec OR snd THEN
  475.            WriteLn;
  476.            WriteString(" XMODEM already active! ");
  477.            WriteLn;
  478.            RETURN FALSE;
  479.         END;
  480.         snd:=TRUE;
  481. (*        crcmode:=TRUE; *)
  482.         mdmini();
  483.         setbuffer(ADR(bufr),BUFSIZ,0c); (* clear buffer *)
  484.         Open(filename,0,fd);
  485.         IF fd<0 THEN
  486.            WriteLn;
  487.            WriteString("GEMDOS ERROR # ");
  488.            WriteInt(fd,2);
  489.            WriteLn;
  490.            xmodemerror:=fd;
  491.            IF Close(fd) THEN END;
  492.            snd:=FALSE;
  493.            RETURN FALSE;
  494.         ELSE
  495.            GetDTA(dtaAdr);
  496.            SFirst(filename,0,result);
  497.            filesize:=dtaAdr+26;
  498.            endblk:=INTEGER(((filesize^+127) DIV 128)+1);
  499.            Assign(xfrname,filename);
  500.            WriteString(" sending ");
  501.            WriteString(filename );
  502.            WriteInt(endblk,5);
  503.            WriteString(" block(s)");
  504.            WriteLn;
  505.         END;
  506.         attempts:=0;
  507.         sectnum:=1;
  508.         j:=0;
  509.         IF crcmode THEN
  510.            nak:=C;
  511.         ELSE
  512.            nak:=NAK;
  513.         END;
  514.         readModem(readchar,5);
  515.         c:=readchar;
  516.         WHILE (c#nak) AND (j<ERRORMAX) DO
  517.               readModem(readchar,20);
  518.               c:=readchar;
  519.               IF j> ERRORMAX DIV 2 THEN
  520.                  crcmode:=NOT crcmode;
  521.                  IF crcmode THEN
  522.                     nak:=C;
  523.                  ELSE
  524.                     nak:=NAK;
  525.                  END;
  526.               END;
  527.               INC(j);
  528.               IF xmodemabort OR (j=ERRORMAX) THEN
  529.                  IF Close(fd) THEN END;
  530.                  xmodemerror:=(-11);
  531.                  snd:=FALSE;
  532.                  RETURN FALSE;
  533.               END;
  534.         END; (* while *)
  535.         flushinput;
  536.         WHILE (endblk#0) AND (attempts#RETRYMAX) DO
  537.               setbuffer(ADR(bufr),BUFSIZ,CTRLZ); 
  538.               b:=BUFSIZ;
  539.               Read(fd,b,ADR(bufr));
  540.               bufptr:=0;
  541.               REPEAT
  542.                 attempts:=0;
  543.                 REPEAT
  544.                   IF xmodemabort THEN
  545.                      IF Close(fd) THEN END;
  546.                      xmodemerror:=(-11);
  547.                      snd:=FALSE;
  548.                      RETURN FALSE;
  549.                   END;
  550.                   sendchar(SOH);
  551.                   sendchar(CHAR(IAnd255(sectnum)));
  552.                   sendchar(CHAR(255-IAnd255(sectnum)));
  553.                   checksum:=0;
  554.                   writeModem(ADR(bufr[bufptr]),SECSIZ);
  555.                   IF crcmode THEN
  556.                      FOR j:=bufptr TO bufptr+SECSIZ-1 DO
  557.                          checksum:=crcupdate(checksum,bufr[j]);
  558.                      END;
  559.                      checksum:=crcfinish(checksum);
  560.                      sendchar(CHAR(IAnd255(CARDINAL(WShr(checksum,8)))));
  561.                      sendchar(CHAR(IAnd255(checksum)));
  562.                   ELSE
  563.                      FOR j:=bufptr TO bufptr+SECSIZ-1 DO
  564.                          checksum:=checksum+CARDINAL(bufr[j]);
  565.                      END;
  566.                      sendchar(CHAR(IAnd255(checksum)));
  567.                   END;
  568.                   flushinput;
  569.                   INC(mdmPacketsSent);
  570.                   INC(attempts);
  571.                   readModem(readchar,mtimeout);
  572.                   c:=readchar;
  573.                   IF c#ACK THEN 
  574.                      INC(mdmNakedPackets);
  575.                   END;
  576.                 UNTIL (c=ACK) OR (attempts=RETRYMAX);
  577.                 IF attempts#RETRYMAX THEN
  578.                    DEC(endblk);
  579.                    bufptr:=bufptr+SECSIZ;
  580.                    mdmBytesXferred:=mdmBytesXferred+SECSIZ;
  581.                    INC(sectnum);
  582.                 END;
  583.               UNTIL (bufptr=BUFSIZ) OR (attempts=RETRYMAX) OR (endblk=0);
  584.         END; (* while *)
  585.  
  586.         IF Close(fd) THEN END;
  587.         IF attempts=RETRYMAX THEN
  588.            xmodemerror:=(-1);
  589.            snd:=FALSE;
  590.            RETURN FALSE;
  591.         ELSE
  592.            attempts:=0;
  593.            REPEAT
  594.                 sendchar(EOT);
  595.                 INC(attempts);
  596.                 readModem(readchar,5);
  597.                 c:=readchar;
  598.            UNTIL (c=ACK) OR (attempts=RETRYMAX);
  599.            xmodemerror:=0;
  600.            snd:=FALSE;
  601.            ok:=TRUE;
  602.            RETURN TRUE;
  603.         END;
  604. END             xmodemsnd;
  605.  
  606. BEGIN
  607. END XMODEM.
  608.